(FILECREATED "31-JUL-73 14:47:02" PAT)


(DEFINEQ

(OUTTUPLE
  [LAMBDA (L)
    (COND
      ((ATOM L)
        L)
      ((EQUAL (CAR L)
              (QUOTE TUPLE))
        (OUTTUPLE (CDR L)))
      (T (CONS (OUTTUPLE (CAR L))
               (OUTTUPLE (CDR L])

(FLATTEN
  [LAMBDA (L)
    (COND
      ((NULL L)
        NIL)
      ((ATOM L)
        (LIST L))
      (T (APPEND (FLATTEN (CAR L))
                 (FLATTEN (CDR L])

(SMATCHQ
  [QLAMBDA
    (TUPLE ←B
           ←A)
    (QATTEMPT
      (QMATCHQ $B $A)
      ELSE
       (IF
         (MEMBER (CAR (OUTTUPLE (FLATTEN $B)))
                 (QUOTE (FOR UNTIL CONS WHILE INSTRUCTIONS
                           DO IF SETQ QMATCHQ)))
           THEN
            (AND
              (PRINT (QUOTE (A COMPLEX MATCH IS REQUIRED)))
              (PRINT (QUOTE (THE ARGUMENTS B AND A ARE)))
              (PRINT $B)
              (PRINT $A)
              (FOR
                X IN $A AS Y IN $B
                 COLLECT
                  (AND
                    (PRINT (QUOTE (X AND Y ARE)))
                    (PRINT X)
                    (PRINT Y)
                    (SETQ NN (LENGTH X))
                    (QMATCHQ ←N
                             (EVAL NN))
                    (PRINT (QUOTE N))
                    (PRINT ?N)
                    (SETQ Y (EVAL Y))
                    (PRINT (QUOTE (WE EVAL Y AND GET)))
                    (PRINT Y)
                    (QMATCHQ ←YY
                             (TUPLE (EVAL Y)))
                    (PRINT (QUOTE (YY IS)))
                    (PRINT $YY)
                    (IF
                      (EQUAL (CAAR $YY)
                             (QUOTE MULTIPLE))
                        THEN
                         (QPROG
                           (DIDIT)
                           (PRINT (QUOTE (WE HAVE A MULTIPLE (
                                               NONDETERMINISTIC)
                                             MATCH)))
                           [FOR
                             Z IN (CDAR $YY)
                              DO
                               (AND
                                 (PRINT (QUOTE (Z IS)))
                                 (PRINT Z)
                                 (IF
                                   (EQUAL X Z)
                                     THEN
                                      [AND
                                        (SETQ DIDIT T)
                                        (RETURN
                                          (QMATCHQ ←YY
                                                   (TUPLE (EVAL Z]
                                   ELSE (PRINT (QUOTE (SORRY THIS DIDNT 
                                                             MATCH X]
                           (IF DIDIT
                               THEN (RETURN T))
                           (PRINT (QUOTE (SORRY NO Z MATCHED X)))
                           (PRINT X)
                           (RETURN (QFAIL)))
                      ELSE T)
                    (QMATCHQ $YY (TUPLE (EVAL X)))
                    (SETQ ARGS (CONS $YY ARGS))
                    (PRINT (QUOTE (THE MATCH SUCCEEDED FOR THIS 
                                                           ARGUMENT)))
                    $YY)))
         ELSE (AND (PRINT (QUOTE (APPARENTLY A SIMPLE MATCH WHICH 
                                             FAILED)))
                   (QFAIL])

(INITIALIZE
  [QLAMBDA
    ←ANY
    (SETQ TUPLE (QUOTE TUPLE))
    [QMATCHQ
      ←FF
      (TUPLE (TUPLE FOR QQ IN (TUPLE QUOTE (TUPLE 2 5 1))
                COLLECT (TUPLE ADD1 (TUPLE TIMES 3 QQ)))
             (TUPLE FOR II FROM 1 UNTIL (TUPLE II GT ?N)
                COLLECT (TUPLE TIMES II 2))
             (TUPLE CONS (TUPLE QUOTE MULTIPLE)
                    (TUPLE FOR JJ FROM 1
                       UNTIL (TUPLE (TUPLE TIMES 3 JJ)
                                    GT ?N)
                       COLLECT
                        (TUPLE FLATTEN
                               (TUPLE LIST (QUOTE TUPLE)
                                      (TUPLE TIMES 2 JJ)
                                      (TUPLE ADD1
                                             (TUPLE TIMES 2 JJ))
                                      (TUPLE QUOTE X)
                                      (TUPLE FOR KK FROM JJ
                                         UNTIL (TUPLE KK GT
                                                      (TUPLE TIMES 2 JJ)
                                                      )
                                         COLLECT (TUPLE LIST
                                                        (TUPLE PLUS KK 
                                                               5)
                                                        (TUPLE PLUS KK 
                                                               6)
                                                        (TUPLE QUOTE X]
    (QMATCHQ ←GG
             (TUPLE (TUPLE 7 16 4)
                    (TUPLE 2 4 6 8 10 12 14 16 18 20 22 24 26 28 30)
                    (TUPLE 4 5 X 7 8 X 8 9 X 9 10 X)))
    (PRINT (QUOTE (END OF INITIALIZATION PROCESS])
)
  (LISPXPRINT (QUOTE PATFNS)
              T)
  (RPAQQ PATFNS (OUTTUPLE FLATTEN SMATCHQ INITIALIZE))
  (LISPXPRINT (QUOTE PATVARS)
              T)
  [RPAQQ PATVARS (ARGS $EE $CC $BB (P (QSETUP PATVARS))
                       (P (INITIALIZE)
                          (PRINT (QUOTE (WE ARE READY]
  (RPAQQ ARGS NIL)
  (RPAQQ $EE NIL)
  (RPAQQ $CC NIL)
  (RPAQQ $BB NIL)
  (QSETUP PATVARS)
  (INITIALIZE)
  (PRINT (QUOTE (WE ARE READY)))
STOP